home *** CD-ROM | disk | FTP | other *** search
/ Leisure Game Pak / Leisure Game Pak.iso / lpgame1 / 04 / source / timing.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-17  |  6KB  |  206 lines

  1. UNIT   Timing;    (* by Marc Palms, 25.6.93 *)
  2.  
  3.  (*  The UNIT supplies a simple timing mechanism to fit loops to
  4.      your machine.
  5.  
  6.      Situation:
  7.        given:  a loop:  for(i=a; i<=a+diff; i+=STEP)
  8.                      {do_action(i); MyDelay(DELAY_TIME);}
  9.  
  10.                where do_action() does some on-screen action
  11.                 (dimming, mouse-movement, ...)
  12.  
  13.        wanted:  values for STEP and DELAY_TIME to fit the loop to
  14.                 your machine
  15.  
  16.        usage:   Start_Measure;
  17.                <loop_without_delay>
  18.                 DELAY_TIME := Get_Step_Delay(time_loop_should_take,
  19.                                  diff,
  20.                                              STEP);
  21.   *)
  22.  
  23.  
  24. INTERFACE
  25.  
  26.  
  27.  
  28.  PROCEDURE  StartMeasure;
  29.  (* ---------------------------------------- *)
  30.   (* This procedure is to be invoked right before the timing-test starts.
  31.    *)
  32.  
  33.  
  34.  
  35.  PROCEDURE  GetStepDelay(    opt_time,
  36.                   diff      : WORD;
  37.              VAR step,
  38.                  wait      : WORD );  (* in&out *)
  39.  (* ---------------------------------------- *)
  40.   (* This procedure returns the step and delay to turn your machine into
  41.      the 'optimum machine'.
  42.      opt_time   :  msecs. the test SHOULD take
  43.      diff       :  times the action is performed when step=1
  44.      step     :  IN : the step-width the test was performed with
  45.                 :  OUT: the optimum step-width
  46.      wait       :  IN : the time-delay (msecs.) the test was performed with
  47.      wait       :  OUT: the optimum time-delay to wait after each step
  48.    *)
  49.  
  50.  
  51.  
  52.  PROCEDURE  AdjustDelay(test_time : WORD);
  53.   (*  The procedure ajusts 'delay_FAC' and 'delay_DIV' to your machine.
  54.       Together with 'MyDelay()' it supplies a more accurate means of
  55.       delay.
  56.       The procedure waits what 'test_time' hsecs and then measures
  57.       the time elapsed, thus computing the adjustment-factor for Delay().
  58.       NOTE:
  59.         test_time should be >= 50 to get accurate results
  60.         (best values :  50 (=0.5secs)  - 300 (=3secs))
  61.         (the higher test_time is the better the results will be)
  62.    *)
  63.  
  64.  
  65.  
  66.  PROCEDURE  MyDelay(msecs : WORD);
  67.  (* ---------------------------------------- *)
  68.   (*  Together with 'CheckDelay()' this procedure supplies a
  69.       machine-independent delay.
  70.    *)
  71.  
  72.  
  73.  
  74.  
  75. IMPLEMENTATION
  76.  
  77.  USES  DOS, CRT;
  78.  
  79.  
  80.  CONST HSECS_PER_DAY = 24 * 60 * 60 * 100;
  81.  
  82.  CONST  delay_FAC  : LONGINT = 100;    (* standard *)
  83.      delay_DIV  : LONGINT = 100;
  84.  
  85.  
  86.  VAR   start_time : LONGINT;
  87.  
  88.  
  89.  PROCEDURE  StartMeasure;
  90.  (* ---------------------------------------- *)
  91.   (* This procedure is to be invoked right before the timing-test starts.
  92.    *)
  93.  
  94.    VAR   h, m, s, hs : WORD;
  95.  
  96.    BEGIN
  97.  
  98.       GetTime(h, m, s, hs);
  99.  
  100.       start_time := (((LONGINT(h) * 60 + m) * 60)+ s) * 100 + hs;
  101.  
  102.    END;  (* Start_Measure *)
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  PROCEDURE  GetStepDelay(    opt_time,
  109.                   diff      : WORD;
  110.              VAR step,
  111.                  wait      : WORD );  (* in&out *)
  112.  (* ---------------------------------------- *)
  113.   (* This procedure returns the step and delay to turn your machine into
  114.      the 'optimum machine'.
  115.      opt_time   :  msecs. the test SHOULD take
  116.      diff       :  times the action is performed when step=1
  117.      step     :  IN : the step-width the test was performed with
  118.                 :  OUT: the optimum step-width
  119.      wait       :  IN : the time-delay (msecs.) the test was performed with
  120.      wait       :  OUT: the optimum time-delay to wait after each step
  121.    *)
  122.  
  123.    VAR   h, m, s, hs : WORD;
  124.          used_time,
  125.          new_wait,
  126.          net_time,
  127.          full_time  : LONGINT;
  128.  
  129.    BEGIN
  130.  
  131.       GetTime(h, m, s, hs);
  132.       used_time := (((LONGINT(h) * 60 + m) * 60)+ s) * 100 + hs - start_time;
  133.  
  134.       WHILE  used_time < 0  DO
  135.         INC(used_time, HSECS_PER_DAY);
  136.       used_time := used_time * 10;    (* hsecs to msecs *)
  137.  
  138.       net_time := used_time - wait * (PRED(diff + step) DIV step);
  139.       IF  net_time < 0  THEN
  140.         net_time := 0;
  141.  
  142.       full_time := net_time * step;
  143.  
  144.       step := full_time DIV opt_time;
  145.       IF  step = 0  THEN  (* your machine is too fast *)
  146.          step := 1;
  147.  
  148.       new_wait := (opt_time * step - full_time) DIV diff;
  149.       IF  new_wait > 0  THEN
  150.          wait := new_wait
  151.       ELSE
  152.            wait := 0;
  153.  
  154.    END; (* GetStepDelay *)
  155.  
  156.  
  157.  
  158.  
  159.  
  160.  PROCEDURE  AdjustDelay(test_time : WORD);
  161.   (*  The procedure ajusts 'delay_FAC' and 'delay_DIV' to your machine.
  162.       Together with 'MyDelay()' it supplies a more accurate means of
  163.       delay.
  164.       The procedure waits what 'test_time' hsecs and then measures
  165.       the time elapsed, thus computing the adjustment-factor for Delay().
  166.       NOTE:
  167.         test_time should be >= 50 to get accurate results
  168.         (best values :  50 (=0.5secs)  - 300 (=3secs))
  169.         (the higher test_time is the better the results will be)
  170.    *)
  171.  
  172.    VAR  start,
  173.        used          : LONGINT;
  174.         h, m, s, hs : WORD;
  175.  
  176.    BEGIN
  177.  
  178.       GetTime(h, m, s, hs);
  179.       start := (((LONGINT(h) * 60 + m) * 60)+ s) * 100 + hs;
  180.       Delay(test_time * 10);
  181.  
  182.       GetTime(h, m, s, hs);
  183.       used := (((LONGINT(h) * 60 + m) * 60)+ s) * 100 + hs - start;
  184.       WHILE  used < 0  DO
  185.         INC(used, HSECS_PER_DAY);
  186.  
  187.       delay_FAC := test_time;
  188.       delay_DIV := used;
  189.  
  190.    END;  (* CheckDelay *)
  191.  
  192.  
  193.  
  194.  
  195.  PROCEDURE  MyDelay(msecs : WORD);
  196.   (*  Together with 'CheckDelay()' this procedure supplies a
  197.       machine-independent delay.
  198.    *)
  199.  
  200.    BEGIN
  201.      IF msecs > 0 THEN Delay((msecs * delay_FAC) DIV delay_DIV);
  202.    END; (* MyDelay *)
  203.  
  204.  
  205. END.  (* UNIT Timing *)
  206.